home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / micros1a / frmmain.frm (.txt) next >
Visual Basic Form  |  1999-09-09  |  9KB  |  211 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   " Mail Merge Sample"
  5.    ClientHeight    =   855
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   2610
  9.    Icon            =   "frmMain.frx":0000
  10.    LinkTopic       =   "Form1"
  11.    LockControls    =   -1  'True
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   855
  15.    ScaleWidth      =   2610
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.CommandButton cmdMailMerge 
  18.       Caption         =   "&Mail Merge"
  19.       Default         =   -1  'True
  20.       Height          =   495
  21.       Left            =   930
  22.       TabIndex        =   0
  23.       Top             =   180
  24.       Width           =   1500
  25.    End
  26.    Begin VB.Image Image1 
  27.       Height          =   480
  28.       Left            =   225
  29.       Picture         =   "frmMain.frx":0442
  30.       Top             =   180
  31.       Width           =   480
  32.    End
  33. Attribute VB_Name = "frmMain"
  34. Attribute VB_GlobalNameSpace = False
  35. Attribute VB_Creatable = False
  36. Attribute VB_PredeclaredId = True
  37. Attribute VB_Exposed = False
  38. Option Explicit
  39. '**(MODULE HEADER)*************************************************
  40. '*   Author: Microsoft Corporation
  41. '*  Purpose: This VB Project was created using sample code from
  42. '*           Microsoft's Knowledgebase.
  43. '******************************************************************
  44. Dim wrdApp      As Word.Application
  45. Dim wrdDoc      As Word.Document
  46. Private Sub cmdMailMerge_Click()
  47.     Dim wrdSelection    As Word.Selection
  48.     Dim wrdMailMerge    As Word.MailMerge
  49.     Dim wrdMergeFields  As Word.MailMergeFields
  50.     Dim StrToAdd        As String
  51.     On Error GoTo Error_Handler
  52.     Screen.MousePointer = vbHourglass
  53.     ' Create an instance of Word  and make it visible
  54.     Set wrdApp = CreateObject("Word.Application")
  55.     wrdApp.Visible = True
  56.     ' Add a new document
  57.     Set wrdDoc = wrdApp.Documents.Add
  58.     wrdDoc.Select
  59.     Set wrdSelection = wrdApp.Selection
  60.     Set wrdMailMerge = wrdDoc.MailMerge
  61.     ' Create MailMerge Data file
  62.     CreateMailMergeDataFile
  63.     ' Create a string and insert it into the document
  64.     StrToAdd = "State University" & vbCr & "Electrical Engineering Department"
  65.     wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphCenter
  66.     wrdSelection.TypeText StrToAdd
  67.     InsertLines 4   ' Insert merge data
  68.     wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphLeft
  69.     Set wrdMergeFields = wrdMailMerge.Fields
  70.     wrdMergeFields.Add wrdSelection.Range, "FirstName"
  71.     wrdSelection.TypeText " "
  72.     wrdMergeFields.Add wrdSelection.Range, "LastName"
  73.     wrdSelection.TypeParagraph
  74.     wrdMergeFields.Add wrdSelection.Range, "Address"
  75.     wrdSelection.TypeParagraph
  76.     wrdMergeFields.Add wrdSelection.Range, "CityStateZip"
  77.     InsertLines 2
  78.     ' Right justify the line and insert a date field' with the current date
  79.     wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphRight
  80.     wrdSelection.InsertDateTime _
  81.     DateTimeFormat:="dddd, MMMM dd, yyyy", InsertAsField:=False
  82.     InsertLines 2
  83.     ' Justify the rest of the document
  84.     wrdSelection.ParagraphFormat.Alignment = wdAlignParagraphJustify
  85.     wrdSelection.TypeText "Dear "
  86.     wrdMergeFields.Add wrdSelection.Range, "FirstName"
  87.     wrdSelection.TypeText ","
  88.     InsertLines 2
  89.     ' Create a string and insert it into the document
  90.     StrToAdd = "Thank you for your recent request for next " & _
  91.                 "semester's class schedule for the Electrical " & _
  92.                 "Engineering Department. Enclosed with this " & _
  93.                 "letter is a booklet containing all the classes " & _
  94.                 "offered next semester at State University.  " & _
  95.                 "Several new classes will be offered in the " & _
  96.                 "Electrical Engineering Department next semester.  " & _
  97.                 "These classes are listed below."
  98.     wrdSelection.TypeText StrToAdd
  99.     InsertLines 2    ' Insert a new table with 9 rows and 4 columns
  100.     wrdDoc.Tables.Add wrdSelection.Range, NumRows:=9, _
  101.     NumColumns:=4
  102.     With wrdDoc.Tables(1)    ' Set the column widths
  103.         .Columns(1).SetWidth 51, wdAdjustNone
  104.         .Columns(2).SetWidth 170, wdAdjustNone
  105.         .Columns(3).SetWidth 100, wdAdjustNone
  106.         .Columns(4).SetWidth 111, wdAdjustNone
  107.         
  108.         ' Set the shading on the first row to light gray
  109.         .Rows(1).Cells.Shading.BackgroundPatternColorIndex = wdGray25
  110.         
  111.         ' Bold the first row
  112.         .Rows(1).Range.Bold = True
  113.         
  114.         ' Center the text in Cell (1,1)
  115.         .Cell(1, 1).Range.Paragraphs.Alignment = wdAlignParagraphCenter
  116.         
  117.         ' Fill each row of the table with data
  118.         FillRow wrdDoc, 1, "Class Number", "Class Name", "Class Time", "Instructor"
  119.         FillRow wrdDoc, 2, "EE220", "Introduction to Electronics II", "1:00-2:00 M,W,F", "Dr. Jensen"
  120.         FillRow wrdDoc, 3, "EE230", "Electromagnetic Field Theory I", "10:00-11:30 T,T", "Dr. Crump"
  121.         FillRow wrdDoc, 4, "EE300", "Feedback Control Systems", "9:00-10:00 M,W,F", "Dr. Murdy"
  122.         FillRow wrdDoc, 5, "EE325", "Advanced Digital Design", "9:00-10:30 T,T", "Dr. Alley"
  123.         FillRow wrdDoc, 6, "EE350", "Advanced Communication Systems", "9:00-10:30 T,T", "Dr. Taylor"
  124.         FillRow wrdDoc, 7, "EE400", "Advanced Microwave Theory", "1:00-2:30 T,T", "Dr. Lee"
  125.         FillRow wrdDoc, 8, "EE450", "Plasma Theory", "1:00-2:00 M,W,F", "Dr. Davis"
  126.         FillRow wrdDoc, 9, "EE500", "Principles of VLSI Design", "3:00-4:00 M,W,F", "Dr. Ellison"
  127.     End With
  128.     ' Go to the end of the document
  129.     wrdApp.Selection.GoTo wdGoToLine, wdGoToLast
  130.     InsertLines 2
  131.     ' Create a string and insert it into the document
  132.     StrToAdd = "For additional information regarding the " & _
  133.                 "Department of Electrical Engineering, " & _
  134.                 "you can visit our Web site at "
  135.     wrdSelection.TypeText StrToAdd
  136.     ' Insert a hyperlink to the Web page
  137.     wrdSelection.Hyperlinks.Add Anchor:=wrdSelection.Range, Address:="http://www.ee.stateu.tld"
  138.     ' Create a string and insert it into the document
  139.     StrToAdd = ".  Thank you for your interest in the classes " & _
  140.                 "offered in the Department of Electrical " & _
  141.                 "Engineering.  If you have any other questions, " & _
  142.                 "please feel free to give us a call at " & _
  143.                 "555-1212." & vbCr & vbCr & _
  144.                 "Sincerely," & vbCr & vbCr & _
  145.                 "Kathryn M. Hinsch" & vbCr & _
  146.                 "Department of Electrical Engineering" & vbCr
  147.     wrdSelection.TypeText StrToAdd
  148.     ' Where to send the document?'
  149.     wrdMailMerge.Destination = wdSendToNewDocument
  150. '    wrdMailMerge.Destination = wdSendToEmail
  151. '    wrdMailMerge.Destination = wdSendToFax
  152. '    wrdMailMerge.Destination = wdSendToPrinter
  153.     ' --- Perform MAIL MERGE --- '
  154.     wrdMailMerge.Execute False
  155.     wrdDoc.PrintPreview
  156.     ' Close the original form document
  157.     wrdDoc.Saved = True
  158. '    wrdDoc.Close False
  159.     ' Notify user we are done.
  160.     MsgBox "Mail Merge Complete.", vbMsgBoxSetForeground
  161.     ' Release References
  162.     Set wrdSelection = Nothing
  163.     Set wrdMailMerge = Nothing
  164.     Set wrdMergeFields = Nothing
  165.     Set wrdDoc = Nothing
  166.     Set wrdApp = Nothing
  167.     ' Cleanup temp file
  168. '    Kill "C:\DataDoc.doc"
  169.     Screen.MousePointer = vbDefault
  170. Exit Sub
  171. Error_Handler:
  172.     Screen.MousePointer = vbDefault
  173.     MsgBox "Error: " & Err.Number & vbLf & vbLf & Err.Description, vbExclamation, "Mail Merge Error!"
  174. End Sub
  175. Public Sub InsertLines(LineNum As Integer)
  176.     Dim iCount As Integer
  177.     'INSERT BLANK LINES IN MS WORD
  178.     For iCount = 1 To LineNum
  179.         wrdApp.Selection.TypeParagraph
  180.     Next iCount
  181. End Sub
  182. Public Sub FillRow(Doc As Word.Document, Row As Integer, _
  183.                    Text1 As String, Text2 As String, _
  184.                    Text3 As String, Text4 As String)
  185.                    
  186.     With Doc.Tables(1)    ' Insert the data into the specific cell
  187.         .Cell(Row, 1).Range.InsertAfter Text1
  188.         .Cell(Row, 2).Range.InsertAfter Text2
  189.         .Cell(Row, 3).Range.InsertAfter Text3
  190.         .Cell(Row, 4).Range.InsertAfter Text4
  191.     End With
  192. End